home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / bytecode.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-04  |  23.5 KB  |  1,163 lines
  1. /* Execution of byte code produced by bytecomp.el.
  2.    Copyright (C) 1992, 1993 Free Software Foundation, Inc.
  3.  
  4. This file is part of XEmacs.
  5.  
  6. XEmacs is free software; you can redistribute it and/or modify it
  7. under the terms of the GNU General Public License as published by the
  8. Free Software Foundation; either version 2, or (at your option) any
  9. later version.
  10.  
  11. XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14. for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with XEmacs; see the file COPYING.  If not, write to the Free
  18. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* Synched up with: Mule 2.0, FSF 19.28. */
  21.  
  22. /*
  23.  
  24. hacked on by jwz@lucid.com 17-jun-91
  25.   o  added a compile-time switch to turn on simple sanity checking;
  26.   o  put back the obsolete byte-codes for error-detection;
  27.   o  added a new instruction, unbind_all, which I will use for 
  28.      tail-recursion elimination;
  29.   o  made temp_output_buffer_show be called with the right number
  30.      of args;
  31.   o  made the new bytecodes be called with args in the right order;
  32.   o  added metering support.
  33.  
  34. by Hallvard:
  35.   o  added relative jump instructions;
  36.   o  all conditionals now only do QUIT if they jump.
  37.  */
  38.  
  39. #include <config.h>
  40. #include "lisp.h"
  41. #include "buffer.h"
  42. #include "syntax.h"
  43.  
  44. /*
  45.  * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for 
  46.  * debugging the byte compiler...)  Somewhat surprisingly, defining this
  47.  * makes Fbyte_code about 8% slower.
  48.  *
  49.  * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. 
  50.  */
  51. /* #define BYTE_CODE_SAFE */
  52. /* #define BYTE_CODE_METER */
  53.  
  54.  
  55. #ifdef BYTE_CODE_METER
  56.  
  57. Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
  58. int byte_metering_on;
  59.  
  60. #define METER_2(code1, code2) \
  61.   XINT (XVECTOR (vector_data (XVECTOR (Vbyte_code_meter))[(code1)]) \
  62.     ->contents[(code2)])
  63.  
  64. #define METER_1(code) METER_2 (0, (code))
  65.  
  66. #define METER_CODE(last_code, this_code)            \
  67. {                                \
  68.   if (byte_metering_on)                        \
  69.     {                                \
  70.       if (METER_1 (this_code) != ((1<<VALBITS)-1))        \
  71.         METER_1 (this_code)++;                    \
  72.       if (last_code                        \
  73.       && METER_2 (last_code, this_code) != ((1<<VALBITS)-1))\
  74.         METER_2 (last_code, this_code)++;            \
  75.     }                                \
  76. }
  77.  
  78. #endif /* no BYTE_CODE_METER */
  79.  
  80.  
  81. Lisp_Object Qbytecode;
  82.  
  83. /*  Byte codes: */
  84.  
  85. #define Bvarref 010
  86. #define Bvarset 020
  87. #define Bvarbind 030
  88. #define Bcall 040
  89. #define Bunbind 050
  90.  
  91. #define Bnth 070
  92. #define Bsymbolp 071
  93. #define Bconsp 072
  94. #define Bstringp 073
  95. #define Blistp 074
  96. #define Beq 075
  97. #define Bmemq 076
  98. #define Bnot 077
  99. #define Bcar 0100
  100. #define Bcdr 0101
  101. #define Bcons 0102
  102. #define Blist1 0103
  103. #define Blist2 0104
  104. #define Blist3 0105
  105. #define Blist4 0106
  106. #define Blength 0107
  107. #define Baref 0110
  108. #define Baset 0111
  109. #define Bsymbol_value 0112
  110. #define Bsymbol_function 0113
  111. #define Bset 0114
  112. #define Bfset 0115
  113. #define Bget 0116
  114. #define Bsubstring 0117
  115. #define Bconcat2 0120
  116. #define Bconcat3 0121
  117. #define Bconcat4 0122
  118. #define Bsub1 0123
  119. #define Badd1 0124
  120. #define Beqlsign 0125
  121. #define Bgtr 0126
  122. #define Blss 0127
  123. #define Bleq 0130
  124. #define Bgeq 0131
  125. #define Bdiff 0132
  126. #define Bnegate 0133
  127. #define Bplus 0134
  128. #define Bmax 0135
  129. #define Bmin 0136
  130. #define Bmult 0137
  131.  
  132. #define Bpoint 0140
  133. #define Bmark 0141 /* no longer generated as of v18 */
  134. #define Bgoto_char 0142
  135. #define Binsert 0143
  136. #define Bpoint_max 0144
  137. #define Bpoint_min 0145
  138. #define Bchar_after 0146
  139. #define Bfollowing_char 0147
  140. #define Bpreceding_char 0150
  141. #define Bcurrent_column 0151
  142. #define Bindent_to 0152
  143. #define Bscan_buffer 0153 /* No longer generated as of v18 */
  144. #define Beolp 0154
  145. #define Beobp 0155
  146. #define Bbolp 0156
  147. #define Bbobp 0157
  148. #define Bcurrent_buffer 0160
  149. #define Bset_buffer 0161
  150. #define Bread_char 0162 /* No longer generated as of v19 */
  151. #define Bset_mark 0163 /* this loser is no longer generated as of v18 */
  152. #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
  153.  
  154. #define Bforward_char 0165
  155. #define Bforward_word 0166
  156. #define Bskip_chars_forward 0167
  157. #define Bskip_chars_backward 0170
  158. #define Bforward_line 0171
  159. #define Bchar_syntax 0172
  160. #define Bbuffer_substring 0173
  161. #define Bdelete_region 0174
  162. #define Bnarrow_to_region 0175
  163. #define Bwiden 0176
  164. #define Bend_of_line 0177
  165.  
  166. #define Bconstant2 0201
  167. #define Bgoto 0202
  168. #define Bgotoifnil 0203
  169. #define Bgotoifnonnil 0204
  170. #define Bgotoifnilelsepop 0205
  171. #define Bgotoifnonnilelsepop 0206
  172. #define Breturn 0207
  173. #define Bdiscard 0210
  174. #define Bdup 0211
  175.  
  176. #define Bsave_excursion 0212
  177. #define Bsave_window_excursion 0213
  178. #define Bsave_restriction 0214
  179. #define Bcatch 0215
  180.  
  181. #define Bunwind_protect 0216
  182. #define Bcondition_case 0217
  183. #define Btemp_output_buffer_setup 0220
  184. #define Btemp_output_buffer_show 0221
  185.  
  186. #define Bunbind_all 0222
  187.  
  188. #define Bset_marker 0223
  189. #define Bmatch_beginning 0224
  190. #define Bmatch_end 0225
  191. #define Bupcase 0226
  192. #define Bdowncase 0227
  193.  
  194. #define Bstringeqlsign 0230
  195. #define Bstringlss 0231
  196. #define Bequal 0232
  197. #define Bnthcdr 0233
  198. #define Belt 0234
  199. #define Bmember 0235
  200. #define Bassq 0236
  201. #define Bnreverse 0237
  202. #define Bsetcar 0240
  203. #define Bsetcdr 0241
  204. #define Bcar_safe 0242
  205. #define Bcdr_safe 0243
  206. #define Bnconc 0244
  207. #define Bquo 0245
  208. #define Brem 0246
  209. #define Bnumberp 0247
  210. #define Bintegerp 0250
  211.  
  212. #define BRgoto 0252
  213. #define BRgotoifnil 0253
  214. #define BRgotoifnonnil 0254
  215. #define BRgotoifnilelsepop 0255
  216. #define BRgotoifnonnilelsepop 0256
  217.  
  218. #define BlistN 0257
  219. #define BconcatN 0260
  220. #define BinsertN 0261
  221.  
  222. #define Bconstant 0300
  223. #define CONSTANTLIM 0100
  224.  
  225. /* Fetch the next byte from the bytecode stream */
  226.  
  227. #define FETCH *pc++
  228.  
  229. /* Fetch two bytes from the bytecode stream
  230.  and make a 16-bit number out of them */
  231.  
  232. #define FETCH2 (op = FETCH, op + (FETCH << 8))
  233.  
  234. /* Push x onto the execution stack. */
  235.  
  236. /* This used to be #define PUSH(x) (*++stackp = (x))
  237.    This oddity is necessary because Alliant can't be bothered to
  238.    compile the preincrement operator properly, as of 4/91.  -JimB  */
  239. #define PUSH(x) (stackp++, *stackp = (x))
  240.  
  241. /* Pop a value off the execution stack.  */
  242.  
  243. #define POP (*stackp--)
  244.  
  245. /* Discard n values from the execution stack.  */
  246.  
  247. #define DISCARD(n) (stackp -= (n))
  248.  
  249. /* Get the value which is at the top of the execution stack, but don't pop it. */
  250.  
  251. #define TOP (*stackp)
  252.  
  253. DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
  254.   "Function used internally in byte-compiled code.\n\
  255. The first argument is a string of byte code; the second, a vector of constants;\n\
  256. the third, the maximum stack depth used in this function.\n\
  257. If the third argument is incorrect, Emacs may crash.")
  258.   (bytestr, vector, maxdepth)
  259.      Lisp_Object bytestr, vector, maxdepth;
  260. {
  261.   /* This function can GC */
  262.   struct gcpro gcpro1, gcpro2, gcpro3;
  263.   int speccount = specpdl_depth ();
  264. #ifdef BYTE_CODE_METER
  265.   int this_op = 0;
  266.   int prev_op;
  267. #endif
  268.   REGISTER int op;
  269.   unsigned char *pc;
  270.   Lisp_Object *stack;
  271.   REGISTER Lisp_Object *stackp;
  272.   Lisp_Object *stacke;
  273.   REGISTER Lisp_Object v1, v2;
  274.   REGISTER Lisp_Object *vectorp = vector_data (XVECTOR (vector));
  275. #ifdef BYTE_CODE_SAFE
  276.   REGISTER int const_length = vector_length (XVECTOR (vector));
  277. #endif
  278.   /* Cached address of beginning of string, valid if BYTESTR data not relocated.  */
  279.   REGISTER unsigned char *strbeg;
  280.   REGISTER struct Lisp_String *detagged_string;
  281.  
  282.   CHECK_STRING (bytestr, 0);
  283.   if (!VECTORP (vector))
  284.     vector = wrong_type_argument (Qvectorp, vector);
  285.   CHECK_NATNUM (maxdepth, 2);
  286.  
  287.   stackp = (Lisp_Object *) alloca (XINT (maxdepth) * sizeof (Lisp_Object));
  288.   memset (stackp, 0, XINT (maxdepth) * sizeof (Lisp_Object));
  289.   GCPRO3 (bytestr, vector, *stackp);
  290.   gcpro3.nvars = XINT (maxdepth);
  291.  
  292.   --stackp;
  293.   stack = stackp;
  294.   stacke = stackp + XINT (maxdepth);
  295.  
  296.   /* Initialize the pc-pointer by fetching from the string.  */
  297.   detagged_string = XSTRING (bytestr);
  298.   pc = string_data (detagged_string);
  299.   strbeg = pc;
  300.  
  301.   while (1)
  302.     {
  303. #ifdef BYTE_CODE_SAFE
  304.       if (stackp > stacke)
  305.     error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d",
  306.            pc - string_data (detagged_string), stacke - stackp);
  307.       if (stackp < stack)
  308.     error ("Byte code stack underflow (byte compiler bug), pc %d",
  309.            pc - string_data (detagged_string));
  310. #endif
  311.  
  312.       if (strbeg != string_data (detagged_string))
  313.     {
  314.       pc = pc - strbeg + string_data (detagged_string);
  315.           strbeg = string_data (detagged_string);
  316.     }
  317.  
  318. #ifdef BYTE_CODE_METER
  319.       prev_op = this_op;
  320.       this_op = op = FETCH;
  321.       METER_CODE (prev_op, op);
  322.       switch (op)
  323. #else
  324.       switch (op = FETCH)
  325. #endif
  326.     {
  327.     case Bvarref+6:
  328.       op = FETCH;
  329.       goto varref;
  330.  
  331.     case Bvarref+7:
  332.       op = FETCH2;
  333.       goto varref;
  334.  
  335.     case Bvarref: case Bvarref+1: case Bvarref+2: case Bvarref+3:
  336.     case Bvarref+4: case Bvarref+5:
  337.       op = op - Bvarref;
  338.     varref:
  339.       v1 = vectorp[op];
  340.       if (!SYMBOLP (v1))
  341.         v2 = Fsymbol_value (v1);
  342.       else
  343.         {
  344.           v2 = XSYMBOL (v1)->value;
  345.           if (SYMBOL_VALUE_MAGIC_P (v2))
  346.                 v2 = Fsymbol_value (v1);
  347.         }
  348.       PUSH (v2);
  349.       break;
  350.  
  351.     case Bvarset+6:
  352.       op = FETCH;
  353.       goto varset;
  354.  
  355.     case Bvarset+7:
  356.       op = FETCH2;
  357.       goto varset;
  358.  
  359.     case Bvarset: case Bvarset+1: case Bvarset+2: case Bvarset+3:
  360.     case Bvarset+4: case Bvarset+5:
  361.       op -= Bvarset;
  362.     varset:
  363.       Fset (vectorp[op], POP);
  364.       break;
  365.  
  366.     case Bvarbind+6:
  367.       op = FETCH;
  368.       goto varbind;
  369.  
  370.     case Bvarbind+7:
  371.       op = FETCH2;
  372.       goto varbind;
  373.  
  374.     case Bvarbind: case Bvarbind+1: case Bvarbind+2: case Bvarbind+3:
  375.     case Bvarbind+4: case Bvarbind+5:
  376.       op -= Bvarbind;
  377.     varbind:
  378.       specbind (vectorp[op], POP);
  379.       break;
  380.  
  381.     case Bcall+6:
  382.       op = FETCH;
  383.       goto docall;
  384.  
  385.     case Bcall+7:
  386.       op = FETCH2;
  387.       goto docall;
  388.  
  389.     case Bcall: case Bcall+1: case Bcall+2: case Bcall+3:
  390.     case Bcall+4: case Bcall+5:
  391.       op -= Bcall;
  392.     docall:
  393.       DISCARD (op);
  394. #ifdef BYTE_CODE_METER
  395.       if (byte_metering_on && SYMBOLP (TOP))
  396.         {
  397.           v1 = TOP;
  398.           v2 = Fget (v1, Qbyte_code_meter, Qnil);
  399.           if (INTP (v2)
  400.                   && XINT (v2) != ((1<<VALBITS)-1))
  401.         {
  402.           XSETINT (v2, XINT (v2) + 1);
  403.           Fput (v1, Qbyte_code_meter, v2);
  404.         }
  405.         }
  406. #endif
  407.       TOP = Ffuncall (op + 1, &TOP);
  408.       break;
  409.  
  410.     case Bunbind+6:
  411.       op = FETCH;
  412.       goto dounbind;
  413.  
  414.     case Bunbind+7:
  415.       op = FETCH2;
  416.       goto dounbind;
  417.  
  418.     case Bunbind: case Bunbind+1: case Bunbind+2: case Bunbind+3:
  419.     case Bunbind+4: case Bunbind+5:
  420.       op -= Bunbind;
  421.     dounbind:
  422.       unbind_to (specpdl_depth () - op, Qnil);
  423.       break;
  424.  
  425.     case Bunbind_all:
  426.       /* To unbind back to the beginning of this frame.  Not used yet,
  427.          but will be needed for tail-recursion elimination. */
  428.       unbind_to (speccount, Qnil);
  429.       break;
  430.  
  431.     case Bgoto:
  432.       QUIT;
  433.       op = FETCH2;    /* pc = FETCH2 loses since FETCH2 contains pc++ */
  434.       pc = string_data (detagged_string) + op;
  435.       break;
  436.  
  437.     case Bgotoifnil:
  438.       op = FETCH2;
  439.       if (NILP (POP))
  440.         {
  441.           QUIT;
  442.           pc = string_data (detagged_string) + op;
  443.         }
  444.       break;
  445.  
  446.     case Bgotoifnonnil:
  447.       op = FETCH2;
  448.       if (!NILP (POP))
  449.         {
  450.           QUIT;
  451.           pc = string_data (detagged_string) + op;
  452.         }
  453.       break;
  454.  
  455.     case Bgotoifnilelsepop:
  456.       op = FETCH2;
  457.       if (NILP (TOP))
  458.         {
  459.           QUIT;
  460.           pc = string_data (detagged_string) + op;
  461.         }
  462.       else DISCARD (1);
  463.       break;
  464.  
  465.     case Bgotoifnonnilelsepop:
  466.       op = FETCH2;
  467.       if (!NILP (TOP))
  468.         {
  469.           QUIT;
  470.           pc = string_data (detagged_string) + op;
  471.         }
  472.       else DISCARD (1);
  473.       break;
  474.  
  475.     case BRgoto:
  476.       QUIT;
  477.       /* pc += *pc - 127; */
  478.       pc = (unsigned char *) ((unsigned long) pc + *pc - 127);
  479.       break;
  480.  
  481.     case BRgotoifnil:
  482.       if (NILP (POP))
  483.         {
  484.           QUIT;
  485.           /* pc += *pc - 128; */
  486.           pc = (unsigned char *) ((unsigned long) pc + *pc - 128);
  487.         }
  488.       pc++;
  489.       break;
  490.  
  491.     case BRgotoifnonnil:
  492.       if (!NILP (POP))
  493.         {
  494.           QUIT;
  495.           /* pc += *pc - 128; */
  496.           pc = (unsigned char *) ((unsigned long) pc + *pc - 128);
  497.         }
  498.       pc++;
  499.       break;
  500.  
  501.     case BRgotoifnilelsepop:
  502.       op = *pc++;
  503.       if (NILP (TOP))
  504.         {
  505.           QUIT;
  506.           /* pc += op - 128; */
  507.           pc = (unsigned char *) ((unsigned long) pc + op - 128);
  508.         }
  509.       else DISCARD (1);
  510.       break;
  511.  
  512.     case BRgotoifnonnilelsepop:
  513.       op = *pc++;
  514.       if (!NILP (TOP))
  515.         {
  516.           QUIT;
  517.           /* pc += op - 128; */
  518.           pc = (unsigned char *) ((unsigned long) pc + op - 128);
  519.         }
  520.       else DISCARD (1);
  521.       break;
  522.  
  523.     case Breturn:
  524.       v1 = POP;
  525.       goto exit;
  526.  
  527.     case Bdiscard:
  528.       DISCARD (1);
  529.       break;
  530.  
  531.     case Bdup:
  532.       v1 = TOP;
  533.       PUSH (v1);
  534.       break;
  535.  
  536.     case Bconstant2:
  537.       PUSH (vectorp[FETCH2]);
  538.       break;
  539.  
  540.     case Bsave_excursion:
  541.       record_unwind_protect (save_excursion_restore, save_excursion_save ());
  542.       break;
  543.  
  544.     case Bsave_window_excursion:
  545.           {
  546.             int count = specpdl_depth ();
  547.             record_unwind_protect (Fset_window_configuration,
  548.                                    Fcurrent_window_configuration (Qnil));
  549.             TOP = Fprogn (TOP);
  550.             unbind_to (count, Qnil);
  551.             break;
  552.           }
  553.  
  554.     case Bsave_restriction:
  555.       record_unwind_protect (save_restriction_restore, save_restriction_save ());
  556.       break;
  557.  
  558.     case Bcatch:
  559.       v1 = POP;
  560.       TOP = internal_catch (TOP, Feval, v1, 0);
  561.       break;
  562.  
  563.     case Bunwind_protect:
  564.       record_unwind_protect (Fprogn, POP);
  565.       break;
  566.  
  567.     case Bcondition_case:
  568.           v1 = POP;           /* handlers */
  569.           v2 = POP;           /* bodyform */
  570.           TOP = Fcondition_case_3 (v2, TOP, v1);
  571.       break;
  572.  
  573.     case Btemp_output_buffer_setup:
  574.       temp_output_buffer_setup ((char *) string_data (XSTRING (TOP)));
  575.       TOP = Vstandard_output;
  576.       break;
  577.  
  578.     case Btemp_output_buffer_show:
  579.       v1 = POP;
  580.       temp_output_buffer_show (TOP, Qnil);
  581.       TOP = v1;
  582.           /* GAG ME!! */
  583.       /* pop binding of standard-output */
  584.       unbind_to (specpdl_depth() - 1, Qnil);
  585.       break;
  586.  
  587.     case Bnth:
  588.       v1 = POP;
  589.       v2 = TOP;
  590.     /* nth_entry: */
  591.       CHECK_INT (v2, 0);
  592.       op = XINT (v2);
  593.       while (--op >= 0)
  594.         {
  595.           if (CONSP (v1))
  596.         v1 = XCDR (v1);
  597.           else if (!NILP (v1))
  598.         {
  599.           v1 = wrong_type_argument (Qlistp, v1);
  600.           op++;
  601.         }
  602.           QUIT;
  603.         }
  604.       goto docar;
  605.  
  606.     case Bsymbolp:
  607.       TOP = ((SYMBOLP (TOP)) ? Qt : Qnil);
  608.       break;
  609.  
  610.     case Bconsp:
  611.       TOP = ((CONSP (TOP)) ? Qt : Qnil);
  612.       break;
  613.  
  614.     case Bstringp:
  615.       TOP = ((STRINGP (TOP)) ? Qt : Qnil);
  616.       break;
  617.  
  618.     case Blistp:
  619.       TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
  620.       break;
  621.  
  622.     case Beq:
  623.       v1 = POP;
  624.       TOP = ((EQ (v1, TOP)) ? Qt : Qnil);
  625.       break;
  626.  
  627.     case Bmemq:
  628.       v1 = POP;
  629.       TOP = Fmemq (TOP, v1);
  630.       break;
  631.  
  632.     case Bnot:
  633.       TOP = NILP (TOP) ? Qt : Qnil;
  634.       break;
  635.  
  636.     case Bcar:
  637.       v1 = TOP;
  638.     docar:
  639.       if (CONSP (v1)) TOP = XCAR (v1);
  640.       else if (NILP (v1)) TOP = Qnil;
  641.       else Fcar (wrong_type_argument (Qlistp, v1));
  642.       break;
  643.  
  644.     case Bcdr:
  645.       v1 = TOP;
  646.       if (CONSP (v1)) TOP = XCDR (v1);
  647.       else if (NILP (v1)) TOP = Qnil;
  648.       else Fcdr (wrong_type_argument (Qlistp, v1));
  649.       break;
  650.  
  651.     case Bcons:
  652.       v1 = POP;
  653.       TOP = Fcons (TOP, v1);
  654.       break;
  655.  
  656.     case Blist1:
  657.       TOP = Fcons (TOP, Qnil);
  658.       break;
  659.  
  660.     case Blist2:
  661.       v1 = POP;
  662.       TOP = Fcons (TOP, Fcons (v1, Qnil));
  663.       break;
  664.  
  665.     case Blist3:
  666.       DISCARD (2);
  667.       TOP = Flist (3, &TOP);
  668.       break;
  669.  
  670.     case Blist4:
  671.       DISCARD (3);
  672.       TOP = Flist (4, &TOP);
  673.       break;
  674.  
  675.     case BlistN:
  676.       op = FETCH;
  677.       DISCARD (op - 1);
  678.       TOP = Flist (op, &TOP);
  679.       break;
  680.  
  681.     case Blength:
  682.       TOP = Flength (TOP);
  683.       break;
  684.  
  685.     case Baref:
  686.           v1 = POP;
  687.       TOP = Faref (TOP, v1);
  688.       break;
  689.  
  690.     case Baset:
  691.       v2 = POP; v1 = POP;
  692.       TOP = Faset (TOP, v1, v2);
  693.       break;
  694.  
  695.     case Bsymbol_value:
  696.       TOP = Fsymbol_value (TOP);
  697.       break;
  698.  
  699.     case Bsymbol_function:
  700.       TOP = Fsymbol_function (TOP);
  701.       break;
  702.  
  703.     case Bset:
  704.       v1 = POP;
  705.       TOP = Fset (TOP, v1);
  706.       break;
  707.  
  708.     case Bfset:
  709.       v1 = POP;
  710.       TOP = Ffset (TOP, v1);
  711.       break;
  712.  
  713.     case Bget:
  714.       v1 = POP;
  715.       TOP = Fget (TOP, v1, Qnil);
  716.       break;
  717.  
  718.     case Bsubstring:
  719.       v2 = POP; v1 = POP;
  720.       TOP = Fsubstring (TOP, v1, v2);
  721.       break;
  722.  
  723.     case Bconcat2:
  724.       DISCARD (1);
  725.       TOP = Fconcat (2, &TOP);
  726.       break;
  727.  
  728.     case Bconcat3:
  729.       DISCARD (2);
  730.       TOP = Fconcat (3, &TOP);
  731.       break;
  732.  
  733.     case Bconcat4:
  734.       DISCARD (3);
  735.       TOP = Fconcat (4, &TOP);
  736.       break;
  737.  
  738.     case BconcatN:
  739.       op = FETCH;
  740.       DISCARD (op - 1);
  741.       TOP = Fconcat (op, &TOP);
  742.       break;
  743.  
  744.     case Bsub1:
  745.       v1 = TOP;
  746.       if (INTP (v1))
  747.         {
  748.           XSETINT (v1, XINT (v1) - 1);
  749.           TOP = v1;
  750.         }
  751.       else
  752.         TOP = Fsub1 (v1);
  753.       break;
  754.  
  755.     case Badd1:
  756.       v1 = TOP;
  757.       if (INTP (v1))
  758.         {
  759.           XSETINT (v1, XINT (v1) + 1);
  760.           TOP = v1;
  761.         }
  762.       else
  763.         TOP = Fadd1 (v1);
  764.       break;
  765.  
  766.     case Beqlsign:
  767.       v2 = POP; v1 = TOP;
  768.       CHECK_INT_OR_FLOAT_COERCE_MARKER (v1, 0);
  769.       CHECK_INT_OR_FLOAT_COERCE_MARKER (v2, 0);
  770.       TOP = (XFLOATINT (v1) == XFLOATINT (v2)) ? Qt : Qnil;
  771.       break;
  772.  
  773.     case Bgtr:
  774.       v1 = POP;
  775.       TOP = Fgtr (TOP, v1);
  776.       break;
  777.  
  778.     case Blss:
  779.       v1 = POP;
  780.       TOP = Flss (TOP, v1);
  781.       break;
  782.  
  783.     case Bleq:
  784.       v1 = POP;
  785.       TOP = Fleq (TOP, v1);
  786.       break;
  787.  
  788.     case Bgeq:
  789.       v1 = POP;
  790.       TOP = Fgeq (TOP, v1);
  791.       break;
  792.  
  793.     case Bdiff:
  794.       DISCARD (1);
  795.       TOP = Fminus (2, &TOP);
  796.       break;
  797.  
  798.     case Bnegate:
  799.       v1 = TOP;
  800.       if (INTP (v1))
  801.         {
  802.           XSETINT (v1, - XINT (v1));
  803.           TOP = v1;
  804.         }
  805.       else
  806.         TOP = Fminus (1, &TOP);
  807.       break;
  808.  
  809.     case Bplus:
  810.       DISCARD (1);
  811.       TOP = Fplus (2, &TOP);
  812.       break;
  813.  
  814.     case Bmax:
  815.       DISCARD (1);
  816.       TOP = Fmax (2, &TOP);
  817.       break;
  818.  
  819.     case Bmin:
  820.       DISCARD (1);
  821.       TOP = Fmin (2, &TOP);
  822.       break;
  823.  
  824.     case Bmult:
  825.       DISCARD (1);
  826.       TOP = Ftimes (2, &TOP);
  827.       break;
  828.  
  829.     case Bquo:
  830.       DISCARD (1);
  831.       TOP = Fquo (2, &TOP);
  832.       break;
  833.  
  834.     case Brem:
  835.       v1 = POP;
  836.       TOP = Frem (TOP, v1);
  837.       break;
  838.  
  839.     case Bpoint:
  840.       v1 = make_number (BUF_PT (current_buffer));
  841.       PUSH (v1);
  842.       break;
  843.  
  844.     case Bgoto_char:
  845.       TOP = Fgoto_char (TOP, Fcurrent_buffer ());
  846.       break;
  847.  
  848.     case Binsert:
  849.       TOP = Finsert (1, &TOP);
  850.       break;
  851.  
  852.     case BinsertN:
  853.       op = FETCH;
  854.       DISCARD (op - 1);
  855.       TOP = Finsert (op, &TOP);
  856.       break;
  857.  
  858.     case Bpoint_max:
  859.       v1 = make_number (BUF_ZV (current_buffer));
  860.       PUSH (v1);
  861.       break;
  862.  
  863.     case Bpoint_min:
  864.       v1 = make_number (BUF_BEGV (current_buffer));
  865.       PUSH (v1);
  866.       break;
  867.  
  868.     case Bchar_after:
  869.       TOP = Fchar_after (TOP, Fcurrent_buffer ());
  870.       break;
  871.  
  872.     case Bfollowing_char:
  873.       v1 = ((BUF_PT (current_buffer) == BUF_ZV (current_buffer)) ? Qzero :
  874.         make_number (BUF_FETCH_CHAR (current_buffer, BUF_PT (current_buffer))));
  875.       PUSH (v1);
  876.       break;
  877.  
  878.     case Bpreceding_char:
  879.       v1 = ((BUF_PT (current_buffer) <= BUF_BEGV (current_buffer)) ?
  880.         Qzero :
  881.         make_number (BUF_FETCH_CHAR (current_buffer,
  882.                          BUF_PT (current_buffer) - 1)));
  883.       PUSH (v1);
  884.       break;
  885.  
  886.     case Bcurrent_column:
  887.       v1 = make_number (current_column (current_buffer));
  888.       PUSH (v1);
  889.       break;
  890.  
  891.     case Bindent_to:
  892.       TOP = Findent_to (TOP, Qnil, Fcurrent_buffer ());
  893.       break;
  894.  
  895.     case Beolp:
  896.       PUSH (Feolp (Fcurrent_buffer ()));
  897.       break;
  898.  
  899.     case Beobp:
  900.       PUSH (Feobp (Fcurrent_buffer ()));
  901.       break;
  902.  
  903.     case Bbolp:
  904.       PUSH (Fbolp (Fcurrent_buffer ()));
  905.       break;
  906.  
  907.     case Bbobp:
  908.       PUSH (Fbobp (Fcurrent_buffer ()));
  909.       break;
  910.  
  911.     case Bcurrent_buffer:
  912.       PUSH (Fcurrent_buffer ());
  913.       break;
  914.  
  915.     case Bset_buffer:
  916.       TOP = Fset_buffer (TOP);
  917.       break;
  918.  
  919.     case Bread_char:
  920.       PUSH (call0 (Qread_char));
  921.       QUIT;
  922.       break;
  923.  
  924.     case Binteractive_p:
  925.       PUSH (Finteractive_p ());
  926.       break;
  927.  
  928.     case Bforward_char:
  929.       TOP = Fforward_char (TOP, Fcurrent_buffer ());
  930.       break;
  931.  
  932.     case Bforward_word:
  933.       TOP = Fforward_word (TOP, Fcurrent_buffer ());
  934.       break;
  935.  
  936.     case Bskip_chars_forward:
  937.       v1 = POP;
  938.       TOP = Fskip_chars_forward (TOP, v1, Fcurrent_buffer ());
  939.       break;
  940.  
  941.     case Bskip_chars_backward:
  942.       v1 = POP;
  943.       TOP = Fskip_chars_backward (TOP, v1, Fcurrent_buffer ());
  944.       break;
  945.  
  946.     case Bforward_line:
  947.       TOP = Fforward_line (TOP, Fcurrent_buffer ());
  948.       break;
  949.  
  950.     case Bchar_syntax:
  951.       CHECK_COERCE_CHAR (TOP, 0);
  952.       TOP = make_number (syntax_code_spec
  953.                               [(int) SYNTAX (current_buffer->syntax_table,
  954.                                              XINT (TOP))]);
  955.       break;
  956.  
  957.     case Bbuffer_substring:
  958.       v1 = POP;
  959.       TOP = Fbuffer_substring (TOP, v1, Fcurrent_buffer ());
  960.       break;
  961.  
  962.     case Bdelete_region:
  963.       v1 = POP;
  964.       TOP = Fdelete_region (TOP, v1, Fcurrent_buffer ());
  965.       break;
  966.  
  967.     case Bnarrow_to_region:
  968.       v1 = POP;
  969.       TOP = Fnarrow_to_region (TOP, v1, Fcurrent_buffer ());
  970.       break;
  971.  
  972.     case Bwiden:
  973.       PUSH (Fwiden (Fcurrent_buffer ()));
  974.       break;
  975.  
  976.     case Bend_of_line:
  977.       TOP = Fend_of_line (TOP, Fcurrent_buffer ());
  978.       break;
  979.  
  980.     case Bset_marker:
  981.       v1 = POP;
  982.       v2 = POP;
  983.       TOP = Fset_marker (TOP, v2, v1);
  984.       break;
  985.  
  986.     case Bmatch_beginning:
  987.       TOP = Fmatch_beginning (TOP);
  988.       break;
  989.  
  990.     case Bmatch_end:
  991.       TOP = Fmatch_end (TOP);
  992.       break;
  993.  
  994.     case Bupcase:
  995.       TOP = Fupcase (TOP, Fcurrent_buffer ());
  996.       break;
  997.  
  998.     case Bdowncase:
  999.       TOP = Fdowncase (TOP, Fcurrent_buffer ());
  1000.     break;
  1001.  
  1002.     case Bstringeqlsign:
  1003.       v1 = POP;
  1004.       TOP = Fstring_equal (TOP, v1);
  1005.       break;
  1006.  
  1007.     case Bstringlss:
  1008.       v1 = POP;
  1009.       TOP = Fstring_lessp (TOP, v1);
  1010.       break;
  1011.  
  1012.     case Bequal:
  1013.       v1 = POP;
  1014.       TOP = Fequal (TOP, v1);
  1015.       break;
  1016.  
  1017.     case Bnthcdr:
  1018.       v1 = POP;
  1019.       TOP = Fnthcdr (TOP, v1);
  1020.       break;
  1021.  
  1022.     case Belt:
  1023. #if 0
  1024.       /* probably this code is OK, but nth_entry is commented
  1025.          out above --ben */
  1026.       if (XTYPE (TOP) == Lisp_Cons)
  1027.         {
  1028.           /* Exchange args and then do nth.  */
  1029.           v2 = POP;
  1030.           v1 = TOP;
  1031.           goto nth_entry;
  1032.         }
  1033. #endif
  1034.       v1 = POP;
  1035.       TOP = Felt (TOP, v1);
  1036.       break;
  1037.  
  1038.     case Bmember:
  1039.       v1 = POP;
  1040.       TOP = Fmember (TOP, v1);
  1041.       break;
  1042.  
  1043.     case Bassq:
  1044.       v1 = POP;
  1045.       TOP = Fassq (TOP, v1);
  1046.       break;
  1047.  
  1048.     case Bnreverse:
  1049.       TOP = Fnreverse (TOP);
  1050.       break;
  1051.  
  1052.     case Bsetcar:
  1053.       v1 = POP;
  1054.       TOP = Fsetcar (TOP, v1);
  1055.       break;
  1056.  
  1057.     case Bsetcdr:
  1058.       v1 = POP;
  1059.       TOP = Fsetcdr (TOP, v1);
  1060.       break;
  1061.  
  1062.     case Bcar_safe:
  1063.       v1 = TOP;
  1064.       if (CONSP (v1))
  1065.         TOP = XCAR (v1);
  1066.       else
  1067.         TOP = Qnil;
  1068.       break;
  1069.  
  1070.     case Bcdr_safe:
  1071.       v1 = TOP;
  1072.       if (CONSP (v1))
  1073.         TOP = XCDR (v1);
  1074.       else
  1075.         TOP = Qnil;
  1076.       break;
  1077.  
  1078.     case Bnconc:
  1079.       DISCARD (1);
  1080.       TOP = Fnconc (2, &TOP);
  1081.       break;
  1082.  
  1083.     case Bnumberp:
  1084.       TOP = ((INT_OR_FLOATP (TOP)) ? Qt : Qnil);
  1085.       break;
  1086.  
  1087.     case Bintegerp:
  1088.       TOP = ((INTP (TOP)) ? Qt : Qnil);
  1089.       break;
  1090.  
  1091. #ifdef BYTE_CODE_SAFE
  1092.     case Bset_mark:
  1093.       error ("set-mark is an obsolete bytecode");
  1094.       break;
  1095.     case Bscan_buffer:
  1096.       error ("scan-buffer is an obsolete bytecode");
  1097.       break;
  1098.     case Bmark:
  1099.       error ("mark is an obsolete bytecode");
  1100.       break;
  1101. #endif
  1102.  
  1103.     default:
  1104. #ifdef BYTE_CODE_SAFE
  1105.       if (op < Bconstant)
  1106.         error ("unknown bytecode %d (byte compiler bug)", op);
  1107.       if ((op -= Bconstant) >= const_length)
  1108.         error ("no constant number %d (byte compiler bug)", op);
  1109.       PUSH (vectorp[op]);
  1110. #else
  1111.       PUSH (vectorp[op - Bconstant]);
  1112. #endif
  1113.     }
  1114.     }
  1115.  
  1116.  exit:
  1117.   UNGCPRO;
  1118.   /* Binds and unbinds are supposed to be compiled balanced.  */
  1119.   if (specpdl_depth() != speccount)
  1120.     /* FSF: abort() if BYTE_CODE_SAFE not defined */
  1121.     error ("binding stack not balanced (serious byte compiler bug)");
  1122.   return v1;
  1123. }
  1124.  
  1125. void
  1126. syms_of_bytecode (void)
  1127. {
  1128.   defsymbol (&Qbytecode, "byte-code");
  1129.   defsubr (&Sbyte_code);
  1130. #ifdef BYTE_CODE_METER
  1131.   defsymbol (&Qbyte_code_meter, "byte-code-meter");
  1132. #endif
  1133. }
  1134.  
  1135. void
  1136. vars_of_bytecode (void)
  1137. {
  1138. #ifdef BYTE_CODE_METER
  1139.  
  1140.   DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
  1141.    "A vector of vectors which holds a histogram of byte-code usage.\n\
  1142. (aref (aref byte-code-meter 0) CODE) indicates how many times the byte\n\
  1143. opcode CODE has been executed.\n\
  1144. (aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,\n\
  1145. indicates how many times the byte opcodes CODE1 and CODE2 have been\n\
  1146. executed in succession.");
  1147.   DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, 
  1148.    "If non-nil, keep profiling information on byte code usage.\n\
  1149. The variable byte-code-meter indicates how often each byte opcode is used.\n\
  1150. If a symbol has a property named `byte-code-meter' whose value is an\n\
  1151. integer, it is incremented each time that symbol's function is called.");
  1152.  
  1153.   byte_metering_on = 0;
  1154.   Vbyte_code_meter = make_vector (256, Qzero);
  1155.   {
  1156.     int i = 256;
  1157.     while (i--)
  1158.       vector_data (XVECTOR (Vbyte_code_meter))[i] =
  1159.     make_vector (256, Qzero);
  1160.   }
  1161. #endif
  1162. }
  1163.